home *** CD-ROM | disk | FTP | other *** search
/ CICA 1993 April / CICA MS Windows - April 1993.iso / unzipped / programr / bcpp / cmmdlg / fontdlg.pas < prev    next >
Pascal/Delphi Source File  |  1992-09-16  |  3KB  |  135 lines
  1. {µµµµµµµµµµµµµµµµµµµµµµµµµµµµµµµµµµµµµµµµµµ}
  2. {   \\\                                    }
  3. {  -(j)-                                   }
  4. {    /juanca                               }
  5. {    ~                                     }
  6. {$D ⌐ ACASA 1989-1992, All rights reserved }
  7. {µµµµµµµµµµµµµµµµµµµµµµµµµµµµµµµµµµµµµµµµµµ}
  8.  
  9. {Shell objects around the Print and PrinterSetup dialogs }
  10.  
  11. UNIT FONTDLG;
  12. {$C MOVEABLE DEMANDLOAD DISCARDABLE}
  13. INTERFACE
  14.   USES
  15.     WINTYPES,
  16.     WOBJECTS,
  17.     COMMDLG,
  18.     COMONDLG;
  19.  
  20.   CONST
  21.     id_FontSample = 1092;
  22.  
  23.              
  24.   TYPE
  25.     pChooseFontDlg= ^tChooseFontDlg;
  26.     tChooseFontDlg = OBJECT ( tCommonDlg )
  27.  
  28.       fontData     :pChooseFont;
  29.  
  30.       CONSTRUCTOR
  31.       init(iparent:PWindowsObject; name :PChar; idata :pChooseFont);
  32.  
  33.       PROCEDURE
  34.       prepareFontData;
  35.         virtual;
  36.  
  37.       FUNCTION
  38.       fontFlags :Longint;
  39.         virtual;
  40.  
  41.       FUNCTION
  42.       execute:Integer;
  43.         virtual;
  44.  
  45.     END;
  46.  
  47. {****************************************************************}
  48. IMPLEMENTATION
  49.  
  50.  
  51.       CONSTRUCTOR
  52.       tChooseFontDlg.
  53.       {}
  54.       init(iparent:PWindowsObject; name :PChar; idata :pChooseFont);
  55.         begin
  56.           tCommonDlg.init(iparent, name);
  57.           fontData := iData;
  58.         end;
  59.  
  60.       FUNCTION
  61.       tChooseFontDlg.
  62.       {}
  63.       fontFlags :Longint;
  64.         begin
  65.           fontFlags := 0
  66.         end;
  67.  
  68.       PROCEDURE
  69.       tChooseFontDlg.
  70.       {}
  71.       prepareFontData;
  72.         begin
  73.           with fontData^
  74.           do begin
  75.             lStructSize   := sizeof(fontData^);
  76.             hInstance     := SYSTEM.HInstance;
  77.             if parent <> nil
  78.             then
  79.               hwndOwner   := parent^.hWindow
  80.             else
  81.               hwndOwner   := 0;
  82.             lpTemplateName:= attr.Name;
  83.             flags         := flags or fontFlags;
  84.  
  85.             lCustData    := Longint(@Self);  {this does nothing, but could be usefull}
  86.  
  87.             if (lpTemplateName <> nil)
  88.             then
  89.               flags := flags or cf_EnableTemplate;
  90.  
  91.             move(Self.instance, lpfnHook, sizeOf(lpfnHook)); {this does the trick!}
  92.             flags := flags or cf_EnableHook
  93.           end;
  94.         end;
  95.  
  96.  
  97.       FUNCTION
  98.       tChooseFontDlg.
  99.       {}
  100.       execute:Integer;
  101.         var
  102.           result :Integer;
  103.           oldKBHandler :pWindowsObject;
  104.         begin
  105.           prepareFontData;
  106.           oldKbHandler := Application^.KBHandlerWnd;
  107.           isModal      := TRUE;  { this is very important, object gets freed twice otherwise !}
  108.           if COMMDLG.chooseFont(fontData^)
  109.           then
  110.             execute := id_Ok
  111.           else begin
  112.             result := commDlgExtendedError;
  113.             if result = 0
  114.             then
  115.               execute := id_Cancel
  116.             else begin
  117.               execute := -result;
  118.               status  := em_InvalidWindow
  119.             end;
  120.           end;
  121.           with fontData^
  122.           do begin
  123.             @lpfnHook := nil;
  124.             lpTemplateName := nil;
  125.             { clear flags used for dialog }
  126.             flags := flags and not ( cf_EnableTemplate or
  127.                                      cf_EnableHook    
  128.                                      );
  129.           end;
  130.           hwindow := 0;
  131.           isModal := FALSE;
  132.           Application^.KBHandlerWnd := OldKbHandler;
  133.         end;
  134.  
  135. END.